home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / tex / td187src.lzh / FILE.I < prev    next >
Text File  |  1991-12-14  |  17KB  |  649 lines
  1. IMPLEMENTATION MODULE File ;
  2.  
  3. FROM SYSTEM   IMPORT ADDRESS , ADR;
  4. FROM Storage  IMPORT ALLOCATE , DEALLOCATE ;
  5. FROM Dialoge  IMPORT BusyStart, BusyEnd;
  6. FROM Diverses IMPORT GetFSelText, NumAlert;
  7. FROM Types    IMPORT DrawObjectTyp, TextPosTyp, CodeAryTyp,
  8.                      CharPtrTyp, ObjectPtrTyp;
  9. IMPORT MagicDOS ;
  10. IMPORT MagicStrings;
  11. IMPORT MagicSys;
  12. IMPORT mtAlerts ;
  13. IMPORT Diverses;
  14. IMPORT GetFile;
  15. IMPORT FileIO;
  16.  
  17. IMPORT Variablen ;
  18. IMPORT CommonData ;
  19. (**
  20. IMPORT RTD;
  21. **)
  22.  
  23. TYPE   ReadOrWrite = ( R , W ) ;
  24.  
  25.  
  26. VAR    FileHandle : INTEGER ;
  27.        Button     : INTEGER ;
  28.        FileVersion: INTEGER ;
  29.        Idum       : INTEGER ;
  30.        Bdum       : BOOLEAN ;
  31.        Cdum       : CARDINAL ;
  32.        Ldum       : MagicSys.lCARDINAL ;
  33.        MergeMode  : BOOLEAN;
  34.  
  35. PROCEDURE Correct(REF Filename    : ARRAY OF CHAR;
  36.                   VAR unilen,
  37.                       resolution,
  38.                       release     : INTEGER ) : BOOLEAN;
  39. VAR res    : BOOLEAN;
  40.     long   : MagicSys.lCARDINAL;
  41.     Handle : INTEGER;
  42.     Button : INTEGER;
  43.     code   : ARRAY [0..39] OF INTEGER;
  44.     adr    : ADDRESS;
  45.     num    : ARRAY [0..9] OF CHAR;
  46.     dtaptr : MagicDOS.PtrDTA;
  47. BEGIN
  48. (**
  49.   RTD.SetDevice(RTD.printer);
  50.   RTD.Write('Correct:', Filename);
  51. **)
  52.   res  := TRUE;
  53.   long := 20 ;
  54.   adr  := ADR ( code );
  55.   dtaptr := MagicDOS.Fgetdta() ;
  56.   Button := MagicDOS.Fsfirst ( Filename ,
  57.              {MagicDOS.ReadOnly, MagicDOS.Archive,
  58.               MagicDOS.Hidden, MagicDOS.System});
  59.   IF (Button=0) AND (dtaptr^.dLength>=20) THEN
  60.     FileIO.Reset(Handle, Filename);
  61.     IF Handle<0 THEN
  62.       res := FALSE;
  63.      ELSE
  64. (**
  65.     MagicDOS.Fread ( Handle , long , adr ) ;
  66. **)
  67.       FileIO.ReadNWords(Handle, 10, code);
  68.  
  69.       FileIO.Close ( Handle ) ;
  70.       IF ORD(code[0])<>ORD(Picture) THEN
  71.         res := FALSE;
  72.       END;
  73.       unilen     := code[6];
  74.       resolution := code[7];
  75.       release    := code[8];
  76.       IF (resolution<1) OR (resolution>5) THEN
  77.         resolution := 3;
  78.       END; (* altes Format *)
  79.     END;
  80.    ELSE
  81.     res := FALSE;
  82.   END;
  83.   IF NOT res THEN
  84.     mtAlerts.SetIcon(mtAlerts.Graphic);
  85. (**
  86.     Button := Diverses.Alert(1, NoPicFile);
  87. **)
  88.     Button := NumAlert(4, 1);
  89.   END;
  90. (**
  91.   RTD.Message('Leaving Correct');
  92. **)
  93.   RETURN res;
  94. END Correct;
  95.  
  96. PROCEDURE SelectFile ( VAR Name   : ARRAY OF CHAR;
  97.                        MSG        : ARRAY OF CHAR;
  98.                        LeaveName  : BOOLEAN;
  99.                        HasToExist : BOOLEAN  ) : INTEGER ;
  100.  
  101. VAR titel    : ARRAY [ 0..128 ] OF CHAR ;
  102.     path     : ARRAY [ 0..128 ] OF CHAR ;
  103.     file     : ARRAY [ 0..12  ] OF CHAR ;
  104.     ext      : ARRAY [ 0..4   ] OF CHAR ;
  105.     tmp1,tmp2: ARRAY [ 0..14   ] OF CHAR ;
  106.     titeladr : ADDRESS ;
  107.     fileadr  : ADDRESS ;
  108.     drive    : CARDINAL ;
  109.     index    : INTEGER ;
  110.     merke    : INTEGER ;
  111.     dummy    : BOOLEAN;
  112.  
  113. BEGIN
  114. (**
  115.   RTD.Message('Into SelectFile ');
  116. **)
  117.   IF LeaveName THEN
  118.     MagicStrings.Assign(Name, titel);
  119.     GetFile.ReplacePath(titel, '');
  120.   END;
  121.   tmp1 := '*.';
  122.   tmp2 := '.';
  123.   MagicStrings.Append(CommonData.Extensions[1], tmp1);
  124.   MagicStrings.Append(CommonData.Extensions[1], tmp2);
  125.   IF GetFile.GetFileName(Name, titel, tmp1, tmp2, CommonData.LTDPath, MSG,
  126.                          dummy, LeaveName, HasToExist, TRUE, FALSE) THEN
  127. (**
  128.     RTD.Message('Leaving SelectFile ');
  129. **)
  130.     RETURN 1;
  131.    ELSE
  132. (**
  133.     RTD.Message('Leaving SelectFile ');
  134. **)
  135.     RETURN 0;
  136.   END;
  137. END SelectFile ;
  138.  
  139.  
  140. PROCEDURE ReadWriteFile ( FileName : ARRAY OF CHAR;
  141.                           RW : ReadOrWrite;
  142.                           SelectFlag : BOOLEAN ) : BOOLEAN ;
  143. (* Lese bzw. schreibe Baum *)
  144.  
  145. VAR rw       : CARDINAL ;
  146.     long     : MagicSys.lCARDINAL ;
  147.     long2    : MagicSys.lCARDINAL ;
  148.     adr      : ADDRESS ;
  149.     z        : INTEGER;
  150.     dummy    : BOOLEAN;
  151.     lookset  : BITSET;
  152.     num      : ARRAY [ 0..3 ] OF CHAR ;
  153.     object   : ObjectPtrTyp ;
  154.     code     : CodeAryTyp ;
  155.     cptr     : CharPtrTyp ;
  156.     eptr     : ADDRESS;
  157.     cbuffer  : ARRAY [0..255] OF CHAR;
  158.     Surround : ARRAY [0..3] OF INTEGER;
  159.  
  160.   PROCEDURE SaveTree(first : ObjectPtrTyp;
  161.                      Subpic, OnlySelected : BOOLEAN) ;
  162.   VAR object : ObjectPtrTyp ;
  163.       number : INTEGER;
  164.   BEGIN
  165. (**
  166.     RTD.Message('Into SaveTree');
  167. **)
  168.     IF Subpic THEN
  169.      object := first^.Children;
  170.      ELSE
  171.       object := first^.Next;
  172.     END;
  173.     number := 0;
  174.     WHILE object<>NIL DO
  175.       IF OnlySelected THEN
  176.         IF object^.Selected THEN
  177.           number := number + 1;
  178.         END;
  179.        ELSE
  180.         number := number + 1;
  181.       END;
  182.       object := object^.Next;
  183.     END;
  184.     first^.Code[5] := number;
  185.     adr := ADR ( first^.Code ) ;
  186.     long := 20;
  187.     MagicDOS.Fwrite ( FileHandle , long , adr ) ;
  188.     IF Subpic THEN
  189.      object := first^.Children;
  190.      ELSE
  191.       object := first^.Next;
  192.     END;
  193.     WHILE object <> NIL DO
  194.       IF (NOT OnlySelected) OR
  195.          (OnlySelected AND object^.Selected) THEN
  196.         IF ORD(object^.Code[0]) <> ORD(Picture) THEN
  197.           long := 20 ;
  198.           adr := ADR ( object^.Code ) ;
  199.           MagicDOS.Fwrite ( FileHandle , long , adr ) ;
  200.           IF object^.Code [ 9 ]  > 0 THEN
  201.             long := MagicSys.CastToLCard ( object^.Code [ 9 ] ) ;
  202.             MagicDOS.Fwrite ( FileHandle , long , object^.CPtr ) ;
  203.           END;
  204.           CASE VAL(DrawObjectTyp, object^.Code[0]) OF
  205.             EpicSolidLine,
  206.             EpicDottedLine,
  207.             EpicDashedLine :
  208.               long2 := 4 * MagicSys.CastToLCard ( object^.Code [ 3 ] ) ;
  209.               IF long2 > 0 THEN
  210.                 MagicDOS.Fwrite ( FileHandle , long2 , object^.EPtr ) ;
  211.               END;|
  212.            ELSE
  213.             long2 := 0;
  214.           END;
  215.          ELSE
  216.           SaveTree(object, TRUE, FALSE);
  217.         END;
  218.       END;
  219.  
  220.       object := object^.Next ;
  221.     END;
  222. (**
  223.     RTD.Message('Leaving SaveTree');
  224. **)
  225.   END SaveTree;
  226.  
  227.   PROCEDURE LoadTree(flag, SelectIt  : BOOLEAN;
  228.                      anzahl: INTEGER) : BOOLEAN;
  229.   (* Ist Flag = 0  so merken wir uns den LastObject-Status und hängen    *)
  230.   (* den Zweig des Baumes um, dabei gehen wir davon aus, daß das zuletzt *)
  231.   (* erzeugte Objekt das Vaterobjekt ist.                                *)
  232.   VAR laststate : ObjectPtrTyp;
  233.       i, read   : INTEGER;
  234.       ok        : BOOLEAN;
  235.   BEGIN
  236. (**
  237.     RTD.Message('LoadTree');
  238.     RTD.ShowVar('anzahl', anzahl);
  239. **)
  240.     IF flag THEN
  241.       laststate := Variablen.LastObject;
  242.     END;
  243.     read := 0;
  244.     ok   := TRUE;
  245.     WHILE (read<anzahl) DO
  246.       long := 20 ;
  247.       adr := ADR ( code ) ;
  248. (**
  249.       MagicDOS.Fread ( FileHandle , long , adr ) ;
  250. **)
  251.       FileIO.ReadNWords( FileHandle, 10, code );
  252.  
  253.       IF ORD(code[0])<>ORD(Picture) THEN
  254. (**
  255.         long := MagicSys.CastToLCard ( code [ 9 ] ) ;
  256. **)
  257.         IF code[9] > 0 THEN
  258. (**
  259.           MagicDOS.Fread ( FileHandle , long , ADR(cbuffer) ) ;
  260. **)
  261. (**
  262.           RTD.Message('Text');
  263.           RTD.ShowVar('len', code[9]);
  264. **)
  265.           FileIO.ReadNBytes( FileHandle, code[9], cbuffer);
  266.           cbuffer[code[9]] := 0C;
  267. (**
  268.           RTD.Write('T ready', cbuffer);
  269.           FOR i:=0 TO code[9] DO
  270.             RTD.ShowVar('cbuf', cbuffer[i]);
  271.           END;
  272. **)
  273.         END (* if *);
  274.         CASE VAL(DrawObjectTyp, code[0]) OF
  275.           EpicSolidLine,
  276.           EpicDottedLine,
  277.           EpicDashedLine :
  278.             long2 := 4 * MagicSys.CastToLCard ( code [ 3 ] ) ; (* 2 * 2 Bytes *)
  279.             IF code[3] > 0 THEN
  280. (**
  281.               MagicDOS.Fread ( FileHandle , long2 , ADR(Variablen.ebuffer) ) ;
  282. **)
  283. (**
  284.               RTD.Message('Epic-Line');
  285. **)
  286.               FileIO.ReadNWords ( FileHandle, 2 * code[3], Variablen.ebuffer );
  287. (**
  288.               RTD.Message('EL ready');
  289. **)
  290.             END;|
  291.          ELSE
  292.           long2 := 0;
  293.         END (* case *);
  294. (**
  295.         RTD.Message('NewOb');
  296. **)
  297.         IF long2<>0 THEN
  298.           IF long<> 0 THEN
  299.             Variablen.NewObject ( code , ADR(cbuffer), ADR(Vari